module Genetic where
-- modul za binarni genetski algoritam

import Random

data DGene = Zero | One
data DHromosome = Hromosome [DGene]
data DUnit = Unit [DHromosome]
data DPopulation = Population [DUnit]

-- instance potrebnih klasa

instance Show DGene where
 show Zero = "0"
 show One = "1"
 
instance Show DHromosome where
 show (Hromosome []) = ""
 show (Hromosome (x:xs)) = show x ++ (show (Hromosome xs))

instance Show DUnit where
 show (Unit []) = ""
 show (Unit (x:xs)) | xs==[] = show x ++ show (Unit xs)
                    | otherwise = show x ++ "," ++ show (Unit xs)
                    
instance Show DPopulation where
 show (Population []) = "\n"
 show (Population (x:xs)) | xs==[] = "(" ++ show x ++ ")" ++ show (Population xs)
                          | otherwise = "(" ++ show x ++ ")" ++ "\n" ++ show (Population xs)

instance Eq DGene where
 One == One = True
 Zero == Zero = True
 _ == _ = False
 
instance Eq DUnit where
 (Unit []) == (Unit []) = True
 (Unit (x:xs)) == (Unit (y:ys)) | x==y = xs == ys
                                | otherwise = False
 
instance Eq DHromosome where
 Hromosome (x:xs) == Hromosome (y:ys) | x/=y = False
                                      | otherwise = (Hromosome xs) == (Hromosome ys)

-- parametri algoritma

hromosomeLength, unitSize, populationSize, mutations :: Int
hromosomeLength = 8
unitSize = 6
populationSize = 32
-- postavimo broj mutacija po generaciji
-- priblizno 10% velicine populacije
mutations = 3

constructHromosome :: Int -> IO DHromosome
constructHromosome length = constructHromosomeRandom (Hromosome []) length
                             
constructHromosomeRandom :: DHromosome -> Int -> IO DHromosome
constructHromosomeRandom (Hromosome hromosome) length
 | length==0 = return (Hromosome hromosome)
 | otherwise = do r <- randomBit
                  randomGene <- toGene r
                  let newLength = length-1
                  hrom <- constructHromosomeRandom (Hromosome (randomGene: hromosome)) newLength
                  return hrom

showHromosome :: IO ()
showHromosome = (constructHromosome hromosomeLength) >>= putStr. show
                 
toGene :: Int -> IO DGene
toGene 0 = return Zero
toGene 1 = return One

randomBit :: IO Int
randomBit = getStdRandom$ randomR (0,1)

randomFromRange :: (Int, Int) -> IO Int
randomFromRange = getStdRandom. randomR

-- konstrukcija jedinke
constructUnit :: Int -> IO DUnit
constructUnit length = constructUnitInternal (Unit []) length

constructUnitInternal :: DUnit -> Int -> IO DUnit
constructUnitInternal (Unit unit) length
 | length==0 = return (Unit unit)
 | otherwise = do hromosome <- constructHromosome hromosomeLength
                  let newLength = length-1
                  u <- constructUnitInternal (Unit (hromosome:unit)) newLength
                  return u
                  
showUnit :: IO ()
showUnit = constructUnit unitSize >>= putStr. show
              
-- konstrukcija populacije
constructPopulation :: Int -> IO DPopulation
constructPopulation size = constructPopulationInternal (Population []) size

constructPopulationInternal :: DPopulation -> Int -> IO DPopulation
constructPopulationInternal (Population pop) size
 | size==0 = return (Population pop)
 | otherwise = do unit <- constructUnit unitSize
                  let newSize = size-1
                  p <- constructPopulationInternal (Population (unit:pop)) newSize
                  return p

showPopulation :: IO ()
showPopulation = do population <- constructPopulation populationSize
                    putStr$ show population

-- mutacije nad hromozomima

class Mutable a where
 mutate :: a -> IO a
 
instance Mutable DGene where
 mutate Zero = return One
 mutate One = return Zero
 
instance Mutable DHromosome where
 mutate (Hromosome hrom) = do position <- randomFromRange (0, hromosomeLength-1)
                              h <- flipGeneAt position (Hromosome hrom)
                              return h
                               
flipGeneAt :: Int -> DHromosome -> IO DHromosome
flipGeneAt position (Hromosome h) = do let genes = h
                                           (first, last1) = splitAt position genes
                                           last2 = tail last1
                                       mutated <- mutate$ head last1
                                       return (Hromosome (first++[mutated]++last2))

-- showMutatedHromosome :: IO ()
-- showMutatedHromosome = do hromosome <- constructHromosome hromosomeLength
--                           putStr$ show hromosome ++ "\n"
--                           mutated <- mutate hromosome
--                           putStr$ show mutated

-- mutacije nad jedinkama

instance Mutable DUnit where
 mutate (Unit hrom) = do position <- randomFromRange (0, unitSize-1)
                         let hromosomes = hrom
                             (front, rear) = splitAt position hromosomes
                             rear2 = tail rear
                         mutated <- mutate$ head rear
                         return (Unit (front++[mutated]++rear2))
                         
-- showMutatedUnit :: IO ()
-- showMutatedUnit = do unit <- constructUnit unitSize
--                      putStr$ show unit ++ "\n"
--                      mutated <- mutate unit
--                      putStr$ show mutated

-- mutiranje populacije

instance Mutable DPopulation where
 mutate (Population pop) = do position <- randomFromRange (0, populationSize-1)
                              let units = pop
                                  (front, rear) = splitAt position units
                                  rear2 = tail rear
                              mutated <- mutate$ head rear
                              return (Population (front++[mutated]++rear2))